Unit BWebJSONUnit;

{$mode objfpc}{$H+}

Interface

Uses
  Classes, SysUtils, strutils, BListsUnit;


Function AddJSItem(Const aIndex: String; Const aValue: String): String;
Function AddJSItem(Const aIndex: String; Const aValue: Integer): String;
Function AddJSItem(Const aIndex: String; Const aValue: Double): String;
Function AddJSItem(Const aIndex: String;
  Const aValue: TDateTime; Const aMask: String): String;
Function AddJSItem(Const aIndex: String; Const aValue: Boolean): String;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: String);
Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: TDateTime; Const aMask: String);
Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Boolean;
  Const aTrue: String = 'true'; Const aFalse: String = 'false');
Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Integer);
Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Double);

Procedure AddJSArray(Var aSource: String; Const aIndex: String;
  Const aValue: String);

Procedure SetJSItem(Var aSource: String;Const aIndex: String;
  Const aValue: String);

Procedure DelJSItem(Var aSource: String; Const aIndex: String);

Function GetJSStr(Const aSource, aIndex: String): String;
Function GetJSInt(Const aSource, aIndex: String): Integer;
Function GetJSFloat(Const aSource, aIndex: String): Double;
Function GetJSBool(Const aSource, aIndex: String): Boolean;
Function GetJSObj(Const  aSource, aIndex: String): String;
Function GetJSArr(Const aSource, aIndex: String;
  Const aBracers: Boolean = FALSE): String;

Function GetJSStrList(Const aSource: String): BStringsList;
Function GetJSIntList(Const aSource: String): BIntegersList;
Function GetJSObjList(Const aSource: String): BStringsList;
Function GetJSArrList(Const aSource: String): BStringsList;
Procedure GetJSStrList(Const aSource: String; Const aOutput: BStringsList);
Procedure GetJSIntList(Const aSource: String; Const aOutput: BIntegersList);
Procedure GetJSObjList(Const aSource: String; Const aOutput: BStringsList);
Procedure GetJSArrList(Const aSource: String; Const aOutput: BStringsList);

Procedure GetJSItem(Const aSource, aIndex: String;
  Out aValue: String); overload;
Procedure GetJSItem(Const aSource, aIndex: String;
  Out aValue: Integer);overload;
Procedure GetJSItem(Const aSource, aIndex: String;
  Out aValue: TDateTime); overload;
Procedure GetJSItem(Const aSource, aIndex: String;
  Out aValue: Double); overload;
Procedure GetJSItem(Const aSource, aIndex: String;
  Out aValue: Boolean); overload;
Function GetJSItem(Const aSource, aIndex: String): String;

Function GetJSArray(Const aSource: String;
  Const aBracers: Boolean = FALSE): BStringsList;
Procedure GetJSArray(Const aSource: String; Const aOutput: BStringsList;
  Const aBracers: Boolean = FALSE);

Function CheckJSItem(Const aSource, aIndex: String): Boolean;
Function CheckJSEmpty(Const aSource: String): Boolean;

Function SimplifyJS(Const aSource: String): String;

Function HTTPEncode(Const AStr: String): String;
Function HTTPDecode(Const AStr: String): String;

Implementation

Function SimplifyJS(Const aSource: String): String;
Begin
  Result := StringReplace(aSource, '\\n', '', [rfReplaceAll]);
  Result := StringReplace(aSource, '\n', '', [rfReplaceAll]);
end;

function HTTPEncode(const AStr: String): String;

const
  HTTPAllowed = ['A'..'Z','a'..'z',
                 '*','@','.','_','-',
                 '0'..'9',
                 '$','!','''','(',')'];

var
  SS,S,R: PChar;
  H : String[2];
  L : Integer;

begin
  L:=Length(AStr);
  SetLength(Result,L*3); // Worst case scenario
  if (L=0) then
    exit;
  R:=PChar(Result);
  S:=PChar(AStr);
  SS:=S; // Avoid #0 limit !!
  while ((S-SS)<L) do
    begin
    if S^ in HTTPAllowed then
      R^:=S^
    else
      begin
      R^:='%';
      H:=HexStr(Ord(S^),2);
      Inc(R);
      R^:=H[1];
      Inc(R);
      R^:=H[2];
      end;
    Inc(R);
    Inc(S);
    end;
  SetLength(Result,R-PChar(Result));
end;

function HTTPDecode(const AStr: String): String;

var
  S,SS, R : PChar;
  H : String[3];
  L,C : Integer;

begin
  L:=Length(Astr);
  SetLength(Result,L);
  If (L=0) then
    exit;
  S:=PChar(AStr);
  SS:=S;
  R:=PChar(Result);
  while (S-SS)<L do
    begin
    case S^ of
      '+': R^ := ' ';
      '%': begin
           Inc(S);
           if ((S-SS)<L) then
             begin
             if (S^='%') then
               R^:='%'
             else
               begin
               H:='$00';
               H[2]:=S^;
               Inc(S);
               If (S-SS)<L then
                 begin
                 H[3]:=S^;
                 Val(H,PByte(R)^,C);
                 If (C<>0) then
                   R^:=' ';
                 end;
               end;
             end;
           end;
      else
        R^ := S^;
      end;
    Inc(R);
    Inc(S);
    end;
  SetLength(Result,R-PChar(Result));
end;

Function AddJSItem(Const aIndex: String; Const aValue: String): String;
Var
  i: Integer;
  lol: String;
Begin
  lol := aValue;
  For i := Length(lol) DownTo 1 Do
    If lol[i] = '"' Then
      Begin
        Delete(lol, i,1);
        Insert('&quot;', lol, i);
      End;
  //If aNeedEncode Then
  //  Result := '"' + aIndex + '":"' + HTTPEncode(lol) + '"'
  //Else
    Result := '"' + aIndex + '":"' + lol + '"'
end;

Function AddJSItem(Const aIndex: String; Const aValue: Integer): String;
Begin
  Result := '"' + aIndex + '":"' + IntToStr(aValue) + '"';
end;

Function AddJSItem(Const aIndex: String; Const aValue: Double): String;
Begin
  Result := '"' + aIndex + '":"' + FloatToStr(aValue) + '"';
end;

Function AddJSItem(Const aIndex: String; Const aValue: TDateTime;
  Const aMask: String): String;
Begin
  Result := '"' + aIndex + '":"' + FormatDateTime(aMask, aValue) + '"';
end;

Function AddJSItem(Const aIndex: String; Const aValue: Boolean): String;
Begin
  If aValue Then Result := '"' + aIndex + '":true'
  Else Result := '"' + aIndex + '":false';
end;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: String);
Begin
  If Not(aSource = '') Then aSource += #44;
  aSource += AddJSItem(aIndex, aValue);
end;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Integer);
Begin
  If Not(aSource = '') Then aSource := aSource + #44;
  aSource := aSource + AddJSItem(aIndex, aValue);
end;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Double);
Begin
  If Not(aSource = '') Then aSource := aSource + #44;
  aSource := aSource + AddJSItem(aIndex, aValue);
end;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: TDateTime; Const aMask: String);
Begin
  If Not(aSource = '') Then aSource := aSource + #44;
  aSource := aSource + AddJSItem(aIndex, aValue, aMask);
end;

Procedure AddJSItem(Var aSource: String; Const aIndex: String;
  Const aValue: Boolean; Const aTrue, aFalse: String);
Begin
  If Not(aSource = '') Then aSource := aSource + #44;
  aSource := aSource + AddJSItem(aIndex, aValue);
end;

Procedure AddJSArray(Var aSource: String; Const aIndex: String;
  Const aValue: String);
Begin
  If Not(aSource = '') Then aSource := aSource + #44;
  aSource := aSource + '"' + aIndex + '":[' + aValue + ']';
end;

Procedure SetJSItem(Var aSource: String; Const aIndex: String;
 Const aValue: String);
Begin
  DelJSItem(aSource, aIndex);
  AddJSItem(aSource, aIndex, aValue);
end;

Procedure DelJSItem(Var aSource: String; Const aIndex: String);
Var
  i: Integer;
Begin
  i := PosEx('"' + aIndex + '":"', aSource);
  If i = 0 Then Exit;
  Delete(aSource, i, PosEx('"', aSource, i + Length('"' + aIndex + '":"')) - i + 1);
  If aSource[1] = ',' Then Delete(aSource, 1, 1);
  If aSource[Length(aSource)] = ',' Then Delete(aSource, Length(aSource), 1);
end;

Function GetJSStr(Const aSource, aIndex: String): String;
Var
  aPos: Integer;
Begin
  aPos := Pos('"' + aIndex + '":"', aSource);
  If aPos = 0 Then Exit('');
  aPos := aPos + Length('"' + aIndex + '":"');
  Result := Copy(aSource, aPos, PosEx('"',aSource, aPos) - aPos);
end;

Function GetJSInt(Const aSource, aIndex: String): Integer;
Var
  aPos: Integer;
  aLast: Integer;
Begin
  aPos := Pos('"' + aIndex + '":', aSource);
  If aPos = 0 Then Exit(-1);
  aPos := aPos + Length('"' + aIndex + '":');
  aLast := PosEx(',', aSource, aPos);
  If aLast = 0 Then aLast := Length(aSource) + 1;
  Result := StrToIntDef(Copy(aSource, aPos, aLast - aPos), -1);
end;

Function GetJSFloat(Const aSource, aIndex: String): Double;
Var
  aPos: Integer;
  aLast: Integer;
Begin
  aPos := Pos('"' + aIndex + '":', aSource);
  If aPos = 0 Then Exit(-1);
  aPos := aPos + Length('"' + aIndex + '":');
  aLast := PosEx(',', aSource, aPos);
  If aLast = 0 Then aLast := Length(aSource) + 1;
  Result := StrToFloatDef(Copy(aSource, aPos, aLast - aPos),-1);
end;

Function GetJSBool(Const aSource, aIndex: String): Boolean;
Var
  aPos: Integer;
  aLast: Integer;
Begin
  aPos := Pos('"' + aIndex + '":', aSource);
  If aPos = 0 Then Exit(FALSE);
  aPos := aPos + Length('"' + aIndex + '":');
  aLast := PosEx(',', aSource, aPos);
  If aLast = 0 Then aLast := Length(aSource) + 1;
  Case Copy(aSource, aPos, aLast - aPos) Of
    'false', '"false"', 'undefined': Result := FALSE
    Else Result := TRUE;
  End;
end;

Function GetJSObj(Const aSource, aIndex: String): String;
Var
  aCount: Integer = 1;
  aPos: Integer;
  i: Integer;
Begin
  Result := '';
  aPos := Pos('"' + aIndex + '":{', aSource);
  If aPos = 0 Then Exit;
  aPos := aPos + Length('"' + aIndex + '":{');
  For i := aPos To Length(aSource) Do
    Begin
      If aSource[i] = '{' Then aCount += 1;
      If aSource[i] = '}' Then aCount -= 1;
      If aCount = 0 Then Exit(Copy(aSource, aPos, i - aPos));
    End;
end;

Function GetJSArr(Const aSource, aIndex: String;
 Const aBracers: Boolean): String;
Var
  aCount: Integer = 1;
  aPos: Integer;
  i: Integer;
Begin
  Result := '';
  aPos := Pos('"' + aIndex + '":[', aSource);
  If aPos = 0 Then Exit;
  aPos := aPos + Length('"' + aIndex + '":[');
  For i := aPos To Length(aSource) Do
    Begin
      If aSource[i] = '[' Then aCount += 1;
      If aSource[i] = ']' Then aCount -= 1;
      If aCount = 0 Then
        Begin
          Result := Copy(aSource, aPos, i - aPos);
          Break;
        End;
    End;
  If aBracers Then Result := '[' + Result + ']';
end;

Function GetJSStrList(Const aSource: String): BStringsList;
Begin
  Result := BStringsList.Build;
  GetJSStrList(aSource, Result);
end;

Function GetJSIntList(Const aSource: String): BIntegersList;
Begin
  Result := BIntegersList.Build;
  GetJSIntList(aSource, Result);
end;

Function GetJSObjList(Const aSource: String): BStringsList;
Begin
  Result := BStringsList.Build;
  GetJSObjList(aSource, Result);
end;

Function GetJSArrList(Const aSource: String): BStringsList;
Begin
  Result := BStringsList.Build;
  GetJSObjList(aSource, Result);
End;

Procedure GetJSStrList(Const aSource: String; Const aOutput: BStringsList);
Var
  aStart: Integer = 1;
  aFinish: Integer = 0;
Begin
  While Not(aStart = 0) Do
    Begin
      aStart := PosEx('"', aSource, aFinish + 1);
      aFinish := PosEx('"', aSource, aStart + 1);
      If (aStart = 0) Or (aFinish = 0) Then Exit;
      aOutput.Add(Copy(aSource, aStart + 1, aFinish - aStart - 1));
    End;
end;

Procedure GetJSIntList(Const aSource: String; Const aOutput: BIntegersList);
Var
  aLength: Integer;
  aStart: Integer;
  aFinish: Integer = 0;
Begin
  While Not(aStart = 0) Do
    Begin
      aStart := aFinish + 1;
      aFinish := PosEx(',', aSource, aStart);
      If (aStart = 0) Or (aFinish = 0) Then Exit;
      aOutput.Add(StrToIntDef(Copy(aSource, aStart, aFinish - aStart), -1));
    End;
  aOutput.Add(StrToIntDef(Copy(aSource, aFinish, Length(aSource) - aFinish),-1))
end;

Procedure GetJSObjList(Const aSource: String; Const aOutput: BStringsList);
Var
  aStart: Integer = 1;
  aFinish: Integer = 0;
  aLength, aCounter: Integer;
  i: Integer;
Begin
  aOutput.Clear;
  aLength := Length(aSource);
  While Not(aFinish = aLength) Do
    Begin
      aCounter := 1;
      aStart := PosEx('{', aSource, aFinish + 1);
      if aStart = 0 Then Break;
      For i := aStart + 1 To aLength Do
        Begin
          If aSource[i] = '{' Then aCounter += 1;
          If aSource[i] = '}' Then aCounter -= 1;
          If aCounter = 0 Then
            Begin
              aFinish := i;
              aOutput.Add(Copy(aSource, aStart + 1, i - aStart - 1));
              Break;
            End
        End;
      If aFinish = aStart - 1 Then aFinish := aLength;
    End;
end;

Procedure GetJSArrList(Const aSource: String; Const aOutput: BStringsList);
Var
  aStart: Integer = 1;
  aFinish: Integer = 0;
  aLength, aCounter: Integer;
  i: Integer;
Begin
  aLength := Length(aSource);
  While Not(aFinish = aLength) Do
    Begin
      aCounter := 1;
      aStart := PosEx('[', aSource, aFinish + 1);
      if aStart = 0 Then Break;
      For i := aStart + 1 To aLength Do
        Begin
          If aSource[i] = '[' Then aCounter += 1;
          If aSource[i] = ']' Then aCounter -= 1;
          If aCounter = 0 Then
            Begin
              aFinish := i;
              aOutput.Add(Copy(aSource, aStart + 1, i - aStart - 1));
              Break;
            End
        End;
      If aFinish = aStart - 1 Then aFinish := aLength;
    End;
end;

Procedure GetJSItem(Const aSource, aIndex: String; Out aValue: String);
Var
  aStart: Integer;
  aLength: Integer;
  aFinish: Integer;
Begin
  aValue := '';
  aStart := Pos('"' + aIndex + '":"', aSource);
  If aStart = 0 Then Exit;
  aLength := Length('"' + aIndex + '":"');
  aFinish := PosEx('"', aSource, aStart + aLength);
  aValue := Copy(aSource, aStart + aLength, aFinish - aStart - aLength);
end;

Procedure GetJSItem(Const aSource, aIndex: String; Out aValue: Integer);
Var
  lol: String;
Begin
  GetJSItem(aSource, aIndex, lol);
  aValue := StrToIntDef(lol, -1);
end;

Procedure GetJSItem(Const aSource, aIndex: String; Out aValue: TDateTime);
  overload;
Var
  lol: String;
Begin
  GetJSItem(aSource, aIndex, lol);
  aValue := StrToDateTime(lol);
end;

Procedure GetJSItem(Const aSource, aIndex: String; Out aValue: Double);
  overload;
Var
  lol: String;
Begin
  GetJSItem(aSource, aIndex, lol);
  aValue := StrToFloat(lol);
end;

Procedure GetJSItem(Const aSource, aIndex: String; Out aValue: Boolean);
Var
  lol: String;
Begin
  GetJSItem(aSource, aIndex, lol);
  If (lol = 'true') Or (lol = 'false') Or (lol = 'undefined') Then
    If lol = 'true' Then
      aValue := TRUE
    Else
      aValue := FALSE
  Else
    aValue := Not(lol = '');
End;

Function GetJSItem(Const aSource, aIndex: String): String;
Begin
  GetJSItem(aSource, aIndex, Result);
end;

Function GetJSArray(Const aSource: String;
  Const aBracers: Boolean): BStringsList;
Begin
  Result := BStringsList.Build;
  GetJSArray(aSource, Result, aBracers);
end;

Procedure GetJSArray(Const aSource: String; Const aOutput: BStringsList;
  Const aBracers: Boolean);
Begin
  If aBracers Then
    GetJSObjList(aSource, aOutput)
  Else
    GetJSArrList(aSource, aOutput);
End;

function CheckJSItem(const aSource, aIndex: String): Boolean;
begin
  Result := Pos('"' + aIndex + '":"', aSource) > 0;
End;

Function CheckJSEmpty(Const aSource: String): Boolean;
Begin
  Result := (aSource = '') Or (aSource = '[]') Or (aSource = '{}') Or
    (aSource = '[{}]');
end;

End.

